home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
UpTime Volume 2 #6
/
utv2n6s1.d64
/
label magic
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-28
|
24KB
|
844 lines
0 rem goto 6740: 07/30/88 @ 06:20:c64 exit @ 610/6180
10 rem -------------------------
20 rem ! authors: dave hammond !
30 rem ! and * jim borden !
40 rem ! *by uptime magazine !
50 rem -------------------------
60 :
70 goto 460:-skip subs!
80 rem--edit label subs--
90 forx=0to4:aa$(x)=z$:next:rem--fill w/blanks
100 xr=0:yc=0:cf=0:rem row=0 / col=0 /change flag =>1=cursor/2=text change
110 rem--main label input loop--
120 for qq=0to2:qq=.
130 if oc$(xr,yc)=""thenoc$(xr,yc)=" "
140 print"[146]"oc$(xr,yc)"[157]";
150 get a$:if a$="" goto 150
160 k=asc(a$)and127:if k=13 goto 250:rem cr
170 ifk=17 goto270:rem--up/down
180 ifk=20 goto320:rem--del/inst
190 ifk=29 goto380:rem--rt/lf
200 ifa$="[133]" goto430:rem--f1 key
210 ifk<32 then next:qq:--not valid!
220 if a$=chr$(34)then next:rem--no quotes allowed
230 cf=cf or 2:print""a$;:oc$(xr,yc)=a$:yc=yc+1:ifyc>29thenyc=yc-1:print"[157]";
240 next:qq
250 print""oc$(xr,yc):xr=xr+1:yc=0:printtab(5):if xr>4thenxr=0:print"[145][145][145][145][145]";
260 next:qq
270 ifa$="[145]"goto300:rem--cur up
280 print""oc$(xr,yc)"[157]";:xr=xr+1:ifxr=5thenxr=0:print"[145][145][145][145][145]";
290 next:qq
300 print""oc$(xr,yc)"[157][145]";:xr=xr-1:if xr<0then xr=4:print"";
310 next:qq
320 cf=cf or 1:if a$<>"[148]" goto 350:rem--del key!
330 print""oc$(xr,yc)"[157]";:for x=28toyc step-1:oc$(xr,x+1)=oc$(xr,x):next:oc$(xr,yc)=" ":printa$" [157][145]"
340 printtab(36)chr$(20)"[145]":printtab(yc+5);:next:qq
350 if yc=0then next:rem--ignore del
360 yc=yc-1:for x=ycto28:oc$(xr,x)=oc$(xr,x+1):next:oc$(xr,x)=" ":printa$"[145]"
370 printtab(34)chr$(148)"[157][157] [145]":printtab(yc+5);:next:qq
380 cf=cf or 1:ifa$="[157]"goto410 :rem--cur left
390 print""oc$(xr,yc);:yc=yc+1:ifyc>29thenyc=29:print"[157]";
400 next:qq
410 print""oc$(xr,yc)"[157][157]";:yc=yc-1:ifyc<0thenyc=0:print"";
420 next:qq
430 qq=9:next:print"[147][215]orking":forqq=0to4:aa$(qq)="":for x=0to29:aa$(qq)=aa$(qq)+oc$(qq,x):next:next:hp=0:x=fre(1):return:-to menu
440 :
450 rem -- start-up sequence --
460 print"[147]"chr$(8)chr$(142):rem--blank screen & uppercase
470 poke53280,0:poke53281,0:rem--black on lt. grey
480 gosub 6180:rem--initialize variables
490 gosub 5890:rem--display cover screen
495 poke 198,0
500 get a$:if a$<>chr$(13) then 500:rem--delay loop
510 print"[147]"chr$(14);:rem--lowercase
520 :
530 rem--main menu--
540 gosub 1010:rem--display menu
550 gosub 1270:rem--get keypress
560 mm=0
570 on key gosub 650, 740,830,920,1900
580 rem file,label,lptr,info,exit
590 :
600 if xt and cm=128 then poke828,173:print"[147][152]";:end:--restore f'(NULL)s/full screen
610 if xt then sys uptime:rem--if exit flag then exit
620 goto 540:rem--main menu on no exit
630 :
640 rem--file mgmnt menu--
650 m=key:ec=3:at$="[146][158]"
660 gosub 1010:rem--display menu
670 gosub 1270:rem--get keypress
680 on key gosub 1950,1950, 1950, 1950,2710,1900
690 rem load,save,scratch,rename, dir,exit
700 if (mm) then return
710 goto 660
720 :
730 rem--label mgmnt menu--
740 m=key
750 gosub 1010:rem--display menu
760 gosub 1270:rem--get keypress
770 on key gosub 3690, 3770, 3860,4070,4210,1900
780 rem add,change,delete,list,sort,exit
790 if (mm) then return
800 goto 750
810 :
820 rem--printer menu--
830 m=key
840 gosub 1010:rem--display menu
850 gosub 1270:rem--get keypress
860 on key gosub 4720,4900,4930,1900
870 rem block, one, all,exit
880 key=m:if (mm) then return
890 goto 830
900 :
910 rem--info & help menu--
920 m=key
930 gosub 1010:rem--display menu
940 gosub 1270:rem--get keypress
950 on key gosub 6810,7050,1900
960 rem info,help,exit
970 if (mm) then return
980 goto 920
990 :
1000 rem--display menu--
1010 if hp=0 then hp=1:gosub 1170:rem--print header
1020 gosub 1220:rem--print cursor legend
1030 gosub 1100:rem--clear text area
1040 print"[158]";spc(sp(m));hd$(m);""
1050 for mn=1 to m(m)
1060 printspc(9)"";mn;"[157]. [158]";m$(m,mn);""
1070 next:return
1080 :
1090 rem--clear text area--
1100 print"";
1110 for c1=1 to cn
1120 print" "
1130 next
1140 cn=17:return
1150 :
1160 rem--print header--
1170 print"[147]"spc(9)"[159][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
1180 print "[192][192][192][192][192][192][192][192][192][179] [204]abel [205]agic 64/128 [171][192][192][192][192][192][192][192][192][192]";
1190 printspc(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":return
1200 :
1210 rem--print cursor legend--
1220 xr=21:yc=5:p=0:gosub 1510
1230 print"[159][213]se [195]ursor [213]p/[196]own[159] for [195]hoice"
1240 printspc(8)" [213]se [210][197][212][213][210][206][159] to [211]elect ":return
1250 :
1260 rem--make selection--
1270 xr=7:yc=8:gosub 1510:rem--position cursor
1280 :
1290 key=1:mr=7+2*(m(m)-1):print"[150][186][157]";
1300 get k$:if k$<>""goto 1300
1310 get k$:if k$=""goto 1310
1320 if k$=chr$(13)goto 1480
1330 if k$=chr$(145)goto 1410
1340 if k$<>chr$(17)goto 1310
1350 :
1360 rem--cursor down--
1370 xr=xr+2:key=key+1:if key>m(m)then key=1: xr=7
1380 goto 1440
1390 :
1400 rem--cursor up--
1410 xr=xr-2:key=key-1:if key=0 then key=m(m):xr=mr
1420 :
1430 rem--print cursor--
1440 print" ":gosub 1510:rem--pos cur
1450 print"[150][186][157]";:goto 1310
1460 :
1470 rem--selection made/exit
1480 return
1490 :
1500 rem--cur pos sub--
1510 printleft$("",xr+1);tab(yc);
1520 return :[for any commo(NULL)re!]
1530 :
1540 rem--kbd input sub--
1550 ct=0:t$="":cs$="[164][157]":printat$cs$;
1560 get k$:if k$<>""goto 1560
1570 get k$:if k$=""goto 1570
1580 if k$="?" or k$="*"goto1570:rem--no wildcards! (save, etc.)
1590 if k$=chr$(13)goto 1860
1600 if k$<>chr$(20)goto 1690
1610 :
1620 rem--delete a character--
1630 if ct=0 goto 1570
1640 if (m<>2)or(ct<>max) then print"[155] [157]";
1650 print"[157] [157]";cs$;
1660 ct=ct-1:t$=left$(t$,ct):goto 1570
1670 :
1680 rem--trap keys--
1690 if ct=max goto 1570
1700 if m<>2 then 1760:rem--not doing labels
1710 :
1720 if(k$>chr$(132))and(k$<chr$(141))goto 1860
1730 if(k$=chr$(17))or(k$=chr$(145))goto 1860
1740 if(k$=chr$(19))or(k$=chr$(147))then 1860
1750 :
1760 if m<>2 and k$=chr$(46)goto 1570
1770 if k$=chr$(34)goto 1570
1780 if k$<chr$(32)goto 1570
1790 if (k$>chr$(95))and(k$<chr$(193))goto 1570
1800 if k$>chr$(218)goto 1570
1810 :
1820 ct=ct+1:t$=t$+k$:printat$;k$;
1830 if ct<>max then printcs$;
1840 goto 1570
1850 :
1860 if (ct<>max)or(m<>2) then printat$" "
1870 return
1880 :
1890 rem--prepare to exit--
1900 xt=1
1910 if m<>0 then xt=0:m=0:mm=1
1920 return
1930 :
1940 rem--get filename--
1950 cn=20:gosub 1100:rem--clear text area
1960 print"";
1970 sp=int((40-len(m$(m,key)))/2)
1980 printspc(sp)"[158]"m$(m,key)""
1990 if key=2 and lf$<>"" then print"[195]urrent [198]ilename: "lf$"[157][157][157][157] "
2000 :
2010 for x=1 to 2
2020 print"[158]"pr$(x);
2030 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
2040 printspc(26)"[145][145]";
2050 max=12:gosub 1550:rem--kbd input
2060 if t$=""then x=2:next:return
2070 f$(x)=t$+".lbl"
2080 if (key<>4) then x=2
2090 next
2100 :
2110 on key gosub 2160,2350, 2520, 2610
2120 rem load,save,scratch,rename
2130 return
2140 :
2150 rem--load a label file--
2160 open15,8,15,"i0"
2170 gosub 5850:rem--err ck
2180 if en<>0 then close15:gosub 5580:return
2190 :
2200 fl$=f$(1):open8,8,8,fl$
2210 gosub 5850:rem--err ck
2220 if en<>0 then close8:close15:fl$="":gosub 5580:return
2230 :
2240 input#8,mx
2250 for x=0tomx:fory=0to4:rem--5 lines(y),mx records(x)
2260 input#8,l$(x,y):next:next:rem--read records
2270 mx=mx+1:if mx=20 goto2290
2280 for x=xto19:for y=0to4:l$(x,y)="":next:next:rem--clear labels
2290 close8:gosub 5850:rem--err ck
2300 close15:mm=1:if en<>0 then fl$="":mm=0:gosub 5580
2310 if mm then m=0:lf$=fl$:rem--to main after load
2320 return
2330 :
2340 rem --save a label file--
2350 open15,8,15,"i0"
2360 gosub 5850:rem--err ck
2370 if en<>0 then close15:gosub 5580:return
2380 :
2390 if mx<1 then print"[206]o [210]ecords!":forx=0to999:next:close15:return
2400 fl$=f$(1):open8,8,8,fl$:go